home *** CD-ROM | disk | FTP | other *** search
/ CD Classic 39 / CD CLASSIC #39 (1998).iso / EMPRESA / visio / Vistdstd / Install / Data.Z / Fields.BAS < prev    next >
BASIC Source File  |  1996-09-04  |  10KB  |  310 lines
  1. Attribute VB_Name = "FIELDS"
  2. ' -----------------------------------------------------------------------------
  3. ' Copyright (C) 1993-1996 Visio Corporation. All rights reserved.
  4. '
  5. ' You have a royalty-free right to use, modify, reproduce and distribute
  6. ' the Sample Application Files (and/or any modified version) in any way
  7. ' you find useful, provided that you agree that Visio has no warranty,
  8. ' obligations or liability for any Sample Application Files.
  9. ' -----------------------------------------------------------------------------
  10.  
  11. Option Explicit
  12. Option Base 0                                       '-- Zero Based Arrays
  13.  
  14. '--
  15. '--   Initialized Flag : Indicates if fields list has been initialized or not.
  16. '--                      Module level variable ONLY.  The shape fields list is
  17. '--                      initialized by FieldNames when m_bInit is False.
  18. '--
  19.  
  20.     Dim m_bInit As Integer
  21.  
  22. '--
  23. '-- Index Constants : Use these constants to index into the fields list.
  24. '--
  25.     Global Const IDX_NAME = 0
  26.     Global Const IDX_DATA1 = 1
  27.     Global Const IDX_DATA2 = 2
  28.     Global Const IDX_DATA3 = 3
  29.     Global Const IDX_TEXT = 4
  30.     Global Const IDX_WIDTH = 5
  31.     Global Const IDX_HEIGHT = 6
  32.     Global Const IDX_MAX = 6
  33.  
  34. '--
  35. '-- Shape Fields List : The following type declares a shapes field descriptor.
  36. '--                     Below it is a zero based array of the shape fields
  37. '--                     that is initialized when m_bInit is False.
  38. '--
  39.     Type SHAPEFIELD
  40.         strName As String
  41.         iIncluded As Integer
  42.         iOrder As Integer
  43.     End Type
  44.  
  45.     Dim m_ShapeFields(0 To IDX_MAX) As SHAPEFIELD
  46.  
  47. '--
  48. '-- Include List : Array of integers containing the indexes of every included
  49. '--                field.  Their order also defines their appearance in the
  50. '--                query when extracting from 0 to IncludeCount.  The counter
  51. '--                maintains the total fields being included.
  52. '--
  53.  
  54.     Dim m_iIncludeList() As Integer
  55.  
  56.     Dim m_iIncludeCount As Integer
  57.  
  58. Private Sub BuildIncludeList()
  59. '------------------------------------
  60. '--- BuildIncludeList ---------------
  61. '--
  62. '--   Builds the include list by reading through the shape fields and, for every
  63. '-- included field, stores its index in the list.
  64. '--
  65.  
  66.     Dim I As Integer, iCount  As Integer
  67.  
  68.     ReDim m_iIncludeList(FieldCount() - 1)          '-- Enlarge To Full Size
  69.     iCount = 0
  70.  
  71.     For I = 0 To FieldCount() - 1                   '-- For Every Field...
  72.         If m_ShapeFields(I).iIncluded Then          '--   If Included...
  73.             m_iIncludeList(iCount) = I              '--     Store Its Index
  74.             iCount = iCount + 1                     '--     Inc. Include Count
  75.         End If
  76.     Next I
  77.  
  78.     m_iIncludeCount = iCount
  79. End Sub
  80.  
  81. Sub DumpFields()
  82.     Dim I As Integer
  83.  
  84.     Debug.Print "Dumping Fields List - FieldCount() = "; FieldCount()
  85.     Debug.Print "-----------------------------------------------------------"
  86.  
  87.     For I = 0 To FieldCount() - 1
  88.         Debug.Print I; Tab(4); "strName:"; m_ShapeFields(I).strName;
  89.         Debug.Print Tab(24); "Inc:"; m_ShapeFields(I).iIncluded;
  90.         Debug.Print "Ord:"; m_ShapeFields(I).iOrder
  91.     Next I
  92. End Sub
  93.  
  94. Sub DumpIncludes()
  95.     Dim I As Integer
  96.  
  97.     Debug.Print "Dumping Include List - m_iIncludeCount = "; IncludeCount()
  98.     Debug.Print "-----------------------------------------------------------"
  99.  
  100.     For I = 0 To IncludeCount() - 1
  101.         Debug.Print Tab(5); I; m_iIncludeList(I); Tab(15); IncludeNames(I)
  102.     Next I
  103. End Sub
  104.  
  105. Function FieldCount() As Integer
  106. '------------------------------------
  107. '--- FieldCount ---------------------
  108. '--
  109. '--   Returns total number of fields available.
  110. '--
  111. '--    Returns : Integer containing number of field available.
  112. '--
  113.  
  114.   FieldCount = IDX_MAX + 1                              '-- Return Total Fields
  115. End Function
  116.  
  117. Function FieldNames(iIndex As Integer) As String
  118. '------------------------------------
  119. '--- FieldNames ---------------------
  120. '--
  121. '--   Returns a string containing the field named by iIndex.
  122. '--
  123. '-- Parameters : iIndex   Integer containing 0 based index of field to return.
  124. '--
  125. '--    Returns : String containing field name or "" if iIndex is invalid.
  126. '--
  127.  
  128.   Dim I As Integer                                  '-- Field Counter
  129.   
  130.   If m_bInit = False Then InitFields                '-- Initialize If Needed
  131.  
  132.   If iIsWithin(iIndex, 0, IDX_MAX) Then             '-- If Valid Index...
  133.     FieldNames = m_ShapeFields(iIndex).strName      '--   Return Field Name
  134.   End If
  135. End Function
  136.  
  137. Function GetIncludeFlag(iIndex As Integer) As Integer
  138. '------------------------------------
  139. '--- GetIncludeFlag -----------------
  140. '--
  141. '--   Returns the included flag for given shape field.
  142. '--
  143.  
  144.     GetIncludeFlag = False
  145.  
  146.     If Not m_bInit Then InitFields
  147.  
  148.     If iIsWithin%(iIndex, 0, IDX_MAX) Then
  149.         GetIncludeFlag = m_ShapeFields(iIndex).iIncluded
  150.     End If
  151. End Function
  152.  
  153. Function IncludeCount() As Integer
  154. '------------------------------------
  155. '--- IncludeCount -------------------
  156. '--
  157. '--   Returns the total fields that are to be included during a query.  If the
  158. '-- module has not been initialized we do so.
  159. '--
  160.  
  161.     
  162.     If Not m_bInit Then InitFields
  163.  
  164.     IncludeCount = m_iIncludeCount
  165. End Function
  166.  
  167. Function IncludeIndex(iIndex As Integer) As Integer
  168. '------------------------------------
  169. '--- IncludeIndex -------------------
  170. '--
  171. '--   Returns the include list index corresponding to the field index passed.
  172. '-- Only works for fields that are in the include list.
  173. '--
  174. '-- Parameters : iIndex - Zero based index of the include field.
  175. '--
  176. '-- Return Val : Integer containing the INCLUDE index of the field passed.  If
  177. '--              iIndex is not in the include list then -1.
  178. '--
  179.  
  180.     Dim I As Integer
  181.  
  182.     If Not m_bInit Then InitFields
  183.  
  184.     IncludeIndex = -1
  185.  
  186.     If iIsWithin(iIndex, 0, FieldCount() - 1) Then
  187.         For I = 0 To IncludeCount() - 1
  188.             If m_iIncludeList(I) = iIndex Then
  189.                 IncludeIndex = I
  190.                 Exit For
  191.             End If
  192.         Next I
  193.     End If
  194. End Function
  195.  
  196. Function IncludeNames(iIndex As Integer)
  197. '------------------------------------
  198. '--- IncludeName --------------------
  199. '--
  200. '--   Equivalent to FieldNames except it returns field names only from the
  201. '-- include list.  To get the size of the include field list use IncludeCount.
  202. '--
  203. '-- Parameters : iIndex - Zero based index of the include field name.
  204. '--
  205. '-- Return Val : String containing the field name or "" if iIndex is invalid.
  206. '--
  207.  
  208.     If Not m_bInit Then InitFields
  209.  
  210.     If iIsWithin(iIndex, 0, IncludeCount() - 1) Then
  211.       IncludeNames = FieldNames(m_iIncludeList(iIndex))
  212.     End If
  213. End Function
  214.  
  215. Private Sub InitFields()
  216. '------------------------------------
  217. '--- InitFields ---------------------
  218. '--
  219. '--   Initalized the field array by setting the name of each field and making
  220. '-- all included by default.
  221. '--
  222.  
  223.     Dim I As Integer
  224.     
  225.     I = -1
  226.     
  227.     I = I + 1: m_ShapeFields(I).strName = "Name"
  228.                m_ShapeFields(I).iIncluded = True
  229.     I = I + 1: m_ShapeFields(I).strName = "Data1"
  230.                m_ShapeFields(I).iIncluded = True
  231.     I = I + 1: m_ShapeFields(I).strName = "Data2"
  232.                m_ShapeFields(I).iIncluded = True
  233.     I = I + 1: m_ShapeFields(I).strName = "Data3"
  234.                m_ShapeFields(I).iIncluded = True
  235.     I = I + 1: m_ShapeFields(I).strName = "Text"
  236.                m_ShapeFields(I).iIncluded = True
  237.     I = I + 1: m_ShapeFields(I).strName = "Width"
  238.                m_ShapeFields(I).iIncluded = True
  239.     I = I + 1: m_ShapeFields(I).strName = "Height"
  240.                m_ShapeFields(I).iIncluded = True
  241.  
  242.     BuildIncludeList
  243.  
  244.     m_bInit = True
  245. End Sub
  246.  
  247. Function SetIncludeFlag(iIndex As Integer, iFlag As Integer) As Integer
  248. '------------------------------------
  249. '--- SetIncludeFlag -----------------
  250. '--
  251. '--   Sets the included flag for a specified shape field.  After setting the
  252. '-- flag we must add the index to the include list.
  253. '--
  254.  
  255.     Dim I As Integer, J As Integer, iTests As Integer
  256.  
  257.     If Not m_bInit Then InitFields
  258.     
  259. '-- Our first two If's make sure that the index and flag are valid.  After that
  260. '-- we check to see if we actually changing a value.  If so we must make sure
  261. '-- that we will not delete the last included field.  However, remember that it
  262. '-- is valid to un-include a field that is ALREADY un-included, it's just
  263. '-- illegal to remove the last include field.
  264.  
  265.     iTests = ((iFlag = True) Or (iFlag = False))
  266.     iTests = iTests And (iIsWithin%(iIndex, 0, IDX_MAX))
  267.     If Not iTests Then Exit Function
  268.  
  269.     SetIncludeFlag = True
  270.  
  271.     If (m_ShapeFields(iIndex).iIncluded <> iFlag) Then
  272.         iTests = ((IncludeCount() > 1) Or iFlag)
  273.  
  274.         If Not iTests Then
  275.             SetIncludeFlag = False
  276.             Exit Function
  277.         End If
  278.     Else
  279.         Exit Function
  280.     End If
  281.  
  282. '--     If all these are True we procede by updating the field's include flag
  283. '-- and updating the include list.
  284. '--     If iFlag = True, we simply add the index to the end of the include list.
  285. '-- Otherwise we search the include list for the index being removed.  When
  286. '-- we find it we copy all indexes above it down one.
  287.  
  288.     m_ShapeFields(iIndex).iIncluded = iFlag
  289.  
  290.     If iFlag = True Then
  291.         m_iIncludeCount = m_iIncludeCount + 1
  292.         m_iIncludeList(m_iIncludeCount - 1) = iIndex
  293.     Else
  294.         '-- Search include list for the element.
  295.         For I = 0 To IncludeCount() - 1
  296.             If m_iIncludeList(I) = iIndex Then          '-- Found!
  297.                         
  298.                 '-- Move all elements above it down one in the list.
  299.                 For J = I To ((IncludeCount() - 1) - 1)
  300.                     m_iIncludeList(J) = m_iIncludeList(J + 1)
  301.                 Next J
  302.  
  303.                 m_iIncludeCount = m_iIncludeCount - 1
  304.                 Exit For
  305.             End If
  306.         Next I
  307.     End If
  308. End Function
  309.  
  310.